home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #3 / Amiga Plus CD - 1997 - No. 03.iso / pd / programmierung / alienbreed3d2_src / amos / compactobj.amos / compactobj.amosSourceCode < prev   
AMOS Source Code  |  1997-01-31  |  5KB  |  274 lines
  1. Set Buffer 80
  2. Screen Open 7,640,24,2,Hires : Wait Vbl : Curs Off : Flash Off : Extension_12_0380 -1
  3. Palette $8,$FF0 : Paper 0 : Pen 1 : Ink 1 : Box 0,4 To 639,20
  4. Global HF,WF
  5. Dim U(128*30),T(128*30),B(128*30)
  6. 1
  7. For A=0 To 64*30 : U(A)=0 : Next 
  8. Screen Open 0,320,256,4,Lowres
  9. Curs Off : Flash Off : Cls 0
  10. Colour 1,$F00
  11. Colour 2,$FFF
  12. Colour 3,$F0
  13. Ink 2 : Box 0,16 To 319,24
  14. Ink 1
  15. Pen 2 : Paper 0
  16. Erase 12
  17. Trap Pload "ab3:includes/findsame.inc",12
  18. If Errtrap
  19.    Screen To Front 7 : Screen 7
  20.    Locate 1,1 : Print Space$(78)
  21.    Locate 1,1 : Centre "Unable to load 'ab3:includes/findsame.inc'"
  22.    Wait Key 
  23.    Edit 
  24. End If 
  25. Erase 15
  26. Reserve As Work 15,640*640+12
  27. F$=Fsel$("ab3:includes/","","Filename: ")
  28. F$=F$-".dat"
  29. F$=F$-".pal"
  30. F$=F$-".wad"
  31. F$=F$-".ptr"
  32. Erase 14
  33. Erase 13
  34. Erase 11
  35. Erase 10
  36. If F$="" : Edit : End If 
  37. Trap Bload F$+".dat",Start(15)
  38. If Errtrap
  39.    Screen To Front 7 : Screen 7
  40.    Locate 1,1 : Print Space$(78)
  41.    Locate 1,1 : Centre "Unable to load '"+F$+".dat'"
  42.    Wait Key 
  43.    Edit 
  44. End If 
  45. NF=Deek(Start(15))
  46. WF=Deek(Start(15)+2)
  47. HF=Deek(Start(15)+4)
  48.  
  49. S=Start(15)+6
  50. For A=4 To WF*HF*NF Step 4
  51.    Loke S-6,Leek(S) : Add S,4
  52. Next 
  53. TL=WF*NF
  54. Reserve As Work 14,WF*HF*NF
  55. Reserve As Work 13,WF*NF*4
  56. Reserve As Work 11,WF*NF*4
  57. Reserve As Work 10,WF*NF*4
  58. Global S,F,D
  59. S=TL
  60. D=NF*WF*HF
  61. 'Goto NOELIM 
  62. Curs Off 
  63. Locate 0,0 : Print "Eliminating repeated strips..."
  64. NS=1
  65.  
  66. F=Start(15)+HF
  67. D=HF
  68. For X=1 To S-1
  69.    
  70.    Loke Start(12),Start(15)
  71.    Loke Start(12)+4,Start(15)+D-HF
  72.    Loke Start(12)+8,F
  73.    Doke Start(12)+12,HF
  74.    Call Start(12)+14
  75.    P=Leek(Start(12))
  76.    If P=-1
  77.       Loke Start(13)+X*4,D/HF
  78.       For A=0 To HF-4 Step 4 : Loke Start(15)+D+A,Leek(F+A) : Next : Add NS,1
  79.       Add D,HF
  80.    Else 
  81.       Loke Start(13)+X*4,P/HF
  82.    End If 
  83.    Locate 0,1
  84.    Print "Bytes Saved:";(F-Start(15))-D;"    "
  85.    H=(X*318)/S+1
  86.    Ink 1
  87.     Extension_12_04CC H,17 To H,23
  88.    H=(NS*318)/S+1
  89.    Ink 3
  90.     Extension_12_04CC H,17 To H,23
  91.    Add F,HF
  92. Next 
  93. '
  94. S=NS
  95. NOELIM:
  96. D=D+Start(14)
  97. 'Goto NOORD
  98. '
  99. U(0)=1
  100. Cls 0
  101. Ink 2 : Box 0,16 To 319,24
  102. Ink 1
  103. Pen 2 : Paper 0
  104. Locate 0,0 : Print "Sorting strips into most efficient order..."
  105. F=Start(15)
  106. For A=0 To S-1
  107.    FINDTOP[F]
  108.    T(A)=Param
  109.    FINDBOT[F]
  110.    B(A)=Param
  111.    Add F,HF
  112. Next 
  113. F=Start(15) : D=Start(14)
  114. E=Start(15)+(S-1)*HF
  115. B=HF-B(0)
  116. For A=0 To HF-1 : Poke D,Peek(F) : Add D,1 : Add F,1 : Next 
  117. '
  118. TD=0
  119. For X=1 To S-1
  120.    DIFF=200
  121.    AD=0
  122.    N=0
  123.    For J=Start(15) To E Step HF
  124.       If U(N)=0
  125.          T=Abs(T(N)-B)
  126.          If T<DIFF
  127.             DIFF=T : AD=J : NU=N
  128.          End If 
  129.          If T=0
  130.             J=E
  131.          End If 
  132.       End If 
  133.       Add N,1
  134.    Next 
  135.    U(NU)=1
  136.    For A=0 To HF-4 Step 4
  137.       Loke D+A,Leek(AD+A)
  138.    Next 
  139.    Loke Start(11)+NU*4,(D-Start(14))/HF
  140.    H=(X*318)/S+1
  141.    Ink 3
  142.     Extension_12_04CC H,17 To H,23
  143.    B=HF-B(NU)
  144.    Add D,HF
  145. Next 
  146. '
  147. NOORD:
  148. 'Goto NOPACK 
  149. Cls 0
  150. TD=0
  151. Ink 2 : Box 0,16 To 319,24
  152. Ink 1
  153. Pen 2 : Paper 0
  154. Locate 0,0 : Print "Packing Strips..."
  155. F=Start(14) : D=Start(14)+HF
  156. For A=0 To HF-1 : Poke Start(14)+A,Peek(Start(15)+A) : Next 
  157. FINDBOT[F] : Add F,HF
  158. B=Param
  159. For X=1 To S-1
  160.    FINDTOP[F]
  161.    T=Param
  162.    J=HF-B
  163.    K=Min(J,T)
  164.    TD=TD+Abs(J-T)
  165.    D=D-K
  166.    FINDBOT[F] : B=Param
  167.    For A=0 To HF-1 : Poke D+A,Peek(F+A) : Next 
  168.    Loke Start(10)+X*4,D-Start(14)
  169.    Add D,HF
  170.    Add F,HF
  171.    Locate 0,1
  172.    Print "Bytes Saved:";(F-D);"    "
  173.    H=(X*318)/S+1
  174.    Ink 1
  175.     Extension_12_04CC H,17 To H,23
  176.    H=(((D-Start(14))/HF)*318)/S+1
  177.    Ink 3
  178.     Extension_12_04CC H,17 To H,23
  179.    H=((TD/HF)*318)/S+1
  180.    Ink 0
  181.     Extension_12_04CC H,17 To H,23
  182. Next 
  183. '
  184. NOPACK:
  185. MD=D-Start(14)
  186. '
  187. For A=0 To TL-1
  188.    P=Leek(Start(13)+A*4)
  189.    P=Leek(Start(11)+P*4)
  190.    P=Leek(Start(10)+P*4)
  191.    Loke Start(13)+A*4,P
  192. Next 
  193. '
  194. LF=MD
  195. LF=LF/3
  196. LF=LF+64
  197.  
  198. For A=0 To TL-1
  199.    P=Leek(Start(13)+A*4)
  200.    If P<=LF and(P+HF)>LF
  201.       FT=P
  202.    End If 
  203.    If(P<=(LF+LF)) and((P+HF)>(LF+LF))
  204.       ST=P
  205.    End If 
  206.    '   If(P<=MD) and((P+HF)>MD) 
  207.    '      MD=P+HF 
  208.    '   End If 
  209. Next 
  210. D=Start(15) : F=Start(14)
  211. For A=0 To MD
  212.    Poke Start(15)+A,0
  213. Next 
  214. For A=0 To FT+HF-1
  215.    Doke D,Peek(F) : Add D,2 : Add F,1
  216. Next 
  217. F=F-HF
  218. BIGD=D
  219. D=Start(15)
  220. For A=FT To ST+HF-1
  221.    C=Deek(D)
  222.    C=C+(Peek(F)*32)
  223.    Doke D,C
  224.    Add D,2 : Add F,1
  225. Next 
  226. BIGD=Max(BIGD,D)
  227. F=F-HF
  228. D=Start(15)
  229. For A=ST To MD+HF-1
  230.    C=Deek(D)
  231.    C=C+(Peek(F)*32*32)
  232.    Doke D,C
  233.    Add D,2 : Add F,1
  234. Next 
  235. BIGD=Max(BIGD,D)
  236. For A=0 To TL-1
  237.    P=Leek(Start(13)+A*4)
  238.    If P>=ST
  239.       P=P-ST
  240.       P=P*2
  241.       P=P+$2000000
  242.    Else 
  243.       If P>=FT
  244.          P=P-FT
  245.          P=P*2
  246.          P=P+$1000000
  247.       Else 
  248.          P=P*2
  249.       End If 
  250.    End If 
  251.    Loke(Start(13)+A*4),P
  252. Next 
  253. '    
  254. Locate 0,4
  255. Print "Old File Size:";TL*HF
  256. ZLF=(BIGD-Start(15))+4*TL
  257. Print "New File Size:";ZLF
  258. Print "Memory saving:";(TL*HF)-ZLF;" = ";((TL*HF-ZLF)*100)/(TL*HF);"%"
  259. Bsave F$+".wad",Start(15) To BIGD
  260. Bsave F$+".ptr",Start(13) To Start(13)+TL*4
  261. Wait Key 
  262. Goto 1
  263. '
  264. Procedure FINDBOT[A]
  265.    Z=HF
  266.    For L=HF-1 To 0 Step -1 : If Peek(A+L)=0 Then Z=L Else L=-10
  267.    Next 
  268. End Proc[Z]
  269. '
  270. Procedure FINDTOP[A]
  271.    Z=0
  272.    For L=0 To HF : If Peek(A+L)=0 Then Z=L+1 Else L=1000
  273.    Next 
  274. End Proc[Z]